
{
module Language.Java.Parser.Lexer where
}

%wrapper "posn"

$digit = 0-9			-- digits
$alpha = [a-zA-Z]		-- alphabetic characters
$graphic    = $printable # $white
$u = [\0-\255]          -- universal: any character

@string     = \" ($u # \")* \"
@char       = \' $printable # \' \'



tokens :-

  "//" [.]* ;                                   -- Toss single line comments
  "/*" ([$u # \*] | \* [$u # \/])* ("*")+ "/" ; -- Toss multi line comments (hopefully)
  $white+				;       -- ignore whitespace

  "import"                              { \p s -> TImport p }
  "package"                             { \p s -> TPackage p }
  "abstract"                            { \p s -> TAbstract p }
  "private"                             { \p s -> TPrivate p }
  "protected"                           { \p s -> TProtected p }
  "final"                               { \p s -> TFinal p }
  "enum"                                { \p s -> TEnum p }
  "class"				{ \p s -> TClass p }
  "new"					{ \p s -> TNew p }
  "static"				{ \p s -> TStatic p }
  "void"				{ \p s -> TVoid p }
  "return"                              { \p s -> TReturn p }
  "public"				{ \p s -> TPublic p }
  "extends"				{ \p s -> TExtend p }
  "byte"                                { \p s -> TByte p}
  "short"                               { \p s -> TShort p}
  "int"					{ \p s -> TInt p }
  "long"                                { \p s -> TLong p}
  "float"                               { \p s -> TFloat p}
  "double"                              { \p s -> TDouble p}
  "char"                                { \p s -> TChar p}
  "boolean"				{ \p s -> TBool p }
--  "String"                              { \p s -> TString p }
  "if"					{ \p s -> TIf p }
  "else"				{ \p s -> TElse p }
  "true"				{ \p s -> TTrue p }
  "false"				{ \p s -> TFalse p }
--  "this"				{ \p s -> TThis p }
--  "length"				{ \p s -> TLength p }
  "while"				{ \p s -> TWhile p }
  "for"                                 { \p s -> TFor p }
  $digit+				{ \p s -> TIntLiteral p (read s) }
  "."                                   { \p s -> TPeriod p }
  "!"					{ \p s -> TNot p }
  "&&"					{ \p s -> TOp p s }
  "&"					{ \p s -> TOp p s }
  "||"					{ \p s -> TOp p s }
  "|"					{ \p s -> TOp p s }
  "^"					{ \p s -> TOp p s }
  "<<"					{ \p s -> TOp p s }
  ">>>"					{ \p s -> TOp p s }
  ">>"					{ \p s -> TOp p s }
  [\*\/\%]                              { \p s -> TOp p s }
  [\+\-]                                { \p s -> TOpPM p s }
  "<"                                   { \p s -> TComOp p s }
  ">"                                   { \p s -> TComOp p s }
  "<="                                  { \p s -> TComOp p s }
  ">="                                  { \p s -> TComOp p s }
  "instanceof"                          { \p s -> TComOp p s }
  "=="                                  { \p s -> TComOp p s }
  "!="                                  { \p s -> TComOp p s }
  "="					{ \p s -> TAssOp p s }
  "+="					{ \p s -> TAssOp p s }
  "-="					{ \p s -> TAssOp p s }
  "*="					{ \p s -> TAssOp p s }
  "/="					{ \p s -> TAssOp p s }
  "%="					{ \p s -> TAssOp p s }
  "&="					{ \p s -> TAssOp p s }
  "^="					{ \p s -> TAssOp p s }
  "|="					{ \p s -> TAssOp p s }
  "<<="					{ \p s -> TAssOp p s }
  ">>>="				{ \p s -> TAssOp p s }
  ">>="					{ \p s -> TAssOp p s }
  ";" 					{ \p s -> TSemiColon p }
  ":"                                   { \p s -> TColon p }
  "("					{ \p s -> TLeftParen p }
  ")"					{ \p s -> TRightParen p }
  "()"                                  { \p s -> TParentheses p }
  $alpha[$alpha $digit \_ \']*		{ \p s -> TIdent p s }
  @string 	       	  		{ \p s -> TStringLiteral p (init (tail s)) } -- remove the leading and trailing double quotes
  @char                                 { \p s -> TCharLiteral p s } 
  "{"	 	 	   		{ \p s -> TLeftBrace p }
  "}"					{ \p s -> TRightBrace p }
  ","					{ \p s -> TComma p }
  "["					{ \p s -> TLeftBrack p }
  "]"					{ \p s -> TRightBrack p }
  "[]"                                  { \p s -> TBrackets p }
  ".*"                                  { \p s -> TImportAll p }
  "++"                                  { \p s -> TIncrement p }
  "--"                                  { \p s -> TDecrement p } 
  "?"                                   { \p s -> TQMark p }
  "~"					{ \p s -> TBitwiseNot p }
  "case"                                { \p s -> TCase p }
  "switch"                              { \p s -> TSwitch p }
  "break"                               { \p s -> TBreak p }
  "continue"                            { \p s -> TContinue p }
  "default"                             { \p s -> TDefault p }

{
-- Each action has type ::AlexPosn -> String -> Token

-- The token type:
data Token =
        TImport { pos :: AlexPosn }             |
        TPackage { pos :: AlexPosn }            |
        TAbstract { pos :: AlexPosn }           |
        TPrivate { pos :: AlexPosn }            |
        TProtected { pos :: AlexPosn }          |
        TFinal { pos :: AlexPosn }              |
        TEnum { pos :: AlexPosn }               |
        TLeftBrace  { pos :: !AlexPosn }	       |
	TRightBrace  { pos :: !AlexPosn }	       |
	TComma  { pos :: AlexPosn }		       |
	TLeftBrack  { pos :: AlexPosn }	       |
	TRightBrack  { pos :: AlexPosn }       |
        TBrackets  { pos :: AlexPosn }         |
	TClass  { pos :: AlexPosn } 	       |
	TPublic  { pos :: AlexPosn }	       |
	TStatic  { pos :: AlexPosn }	       |
	TVoid  { pos :: AlexPosn }		       |
	TExtend  { pos :: AlexPosn }	       |
	TByte { pos :: AlexPosn }		       |
	TShort { pos :: AlexPosn }		       |
	TInt  { pos :: AlexPosn }		       |
	TLong { pos :: AlexPosn }		       |
	TFloat { pos :: AlexPosn }		       |
	TDouble { pos :: AlexPosn }		       |
	TChar { pos :: AlexPosn }		       |
	TBool  { pos :: AlexPosn }		       |
	TString { pos :: AlexPosn }		       |
	TIf  { pos :: AlexPosn }		       |
	TElse  { pos :: AlexPosn }		       |
	TTrue  { pos :: AlexPosn }		       |
	TFalse  { pos :: AlexPosn }		       |
--	TThis  { pos :: AlexPosn }		       |
--	TLength  { pos :: AlexPosn }	       |
	TWhile  { pos :: AlexPosn }		       |
	TFor  { pos :: AlexPosn }		       |
	TNew  { pos :: AlexPosn }		       |
	TOp  { pos :: AlexPosn , s :: String }             |
	TOpPM { pos :: AlexPosn , s :: String }            |
	TComOp  { pos :: AlexPosn, s :: String }           |
        TNot  { pos :: AlexPosn }                  |
	TAssOp  { pos :: AlexPosn, s :: String }           |
	TPeriod  { pos :: AlexPosn }               |
	TSemiColon  { pos :: AlexPosn }            |
	TColon  { pos :: AlexPosn }                |
	TLeftParen  { pos :: AlexPosn } 	       |
	TRightParen  { pos :: AlexPosn } 	       |
	TParentheses { pos :: AlexPosn } 	       |
	TIdent  { pos :: AlexPosn , s :: String	}       |
	TIntLiteral  { pos :: AlexPosn , i:: Int}       |
	TStringLiteral  { pos :: AlexPosn , s:: String } |
	TCharLiteral { pos :: AlexPosn, s :: String }    |
        TReturn  { pos :: AlexPosn }                    |
        TImportAll { pos :: AlexPosn }          |
        TQMark { pos :: AlexPosn }              |
        TBitwiseNot { pos :: AlexPosn }         |
        TIncrement {pos :: AlexPosn }           |
        TDecrement {pos :: AlexPosn }           |
        TCase { pos :: AlexPosn }               |
        TSwitch { pos :: AlexPosn }             |
        TBreak { pos :: AlexPosn }              |
        TContinue { pos :: AlexPosn }           |
        TDefault { pos :: AlexPosn }
	deriving (Eq,Show)


tokenStringValue :: Token -> String
tokenStringValue (TIdent _ s)         = s
tokenStringValue (TStringLiteral _ s) = s
tokenStringValue (TCharLiteral _ s)   = s
tokenStringValue _                    = error ("ERROR: tokenStringValue applied to wrong token-type")

tokenIntValue :: Token -> Int
tokenIntValue (TIntLiteral _ i) = i
tokenIntValue _                 = error ("ERROR: tokenIntValue applied to non-int token")

tokenOpValue :: Token -> String
tokenOpValue (TOp _ s)     = s
tokenOpValue (TComOp _ s)  = s
tokenOpValue (TAssOp _ s)  = s
tokenOpValue (TOpPM _ s)  = s
tokenOpValue _             = error ("ERROR: tokenOpValue applied to non-op token")

tokenPosn :: Token -> AlexPosn
tokenPosn t = pos t



getLineNum :: AlexPosn -> Int
getLineNum (AlexPn offset lineNum colNum) = lineNum 

getColumnNum :: AlexPosn -> Int
getColumnNum (AlexPn offset lineNum colNum) = colNum

-- increments the columnNumber (and thus also the offset) of a given AlexPosn by the given int value
incColNum :: AlexPosn -> Int -> AlexPosn
incColNum (AlexPn offset lineNum colNum) i = (AlexPn (offset+i) lineNum (colNum+i))

-- increments the columnNumber (and thus also the offset) of a given AlexPosn by the length of a given String
incColNumS :: AlexPosn -> String -> AlexPosn
incColNumS (AlexPn offset lineNum colNum) s = (AlexPn (offset+(length s)) lineNum (colNum+(length s)))


--alexScanTokens :: String -> [token]
alexScanTokens2 str = go (alexStartPos,'\n',str)
  where go inp@(pos,_,str) =
          case alexScan inp 0 of
                AlexEOF -> []
                AlexError _ -> error ("lexical error @ line " ++ show (getLineNum(pos)) ++ " and column " ++ show (getColumnNum(pos)))
                AlexSkip  inp' len     -> go inp'
                AlexToken inp' len act -> act pos (take len str) : go inp'


}
